home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 2 / LSD and 17bit Compendium Deluxe - Volume II.iso / a / prog / misc / guienv374.lha / GUIEnvironment / M2Amiga / Examples / ResizingExample.mod < prev    next >
Text File  |  1994-10-29  |  13KB  |  277 lines
  1. (****************************************************************************
  2.  
  3. $RCSfile: ResizingExample.mod $
  4.  
  5. $Revision: 1.4 $
  6.     $Date: 1994/09/30 15:56:10 $
  7.  
  8.     GUIEnvironment example: Resizing, GUIEnvironment gadgets, Font adaptive
  9.  
  10.     M2Amiga Modula-2 Compiler V4.3
  11.  
  12.   Copyright © 1994, Carsten Ziegeler
  13.                     Augustin-Wibbelt-Str.7, 33106 Paderborn, Germany
  14.  
  15. ****************************************************************************)
  16. MODULE ResizingExample;
  17.  
  18. (* This example shows, how the gadget descriptions can be used for
  19.    resizable gadgets. It also shows the GUIEnvironment gadgets in action !
  20.    It also shows the simple to use font adaptivity *)
  21.  
  22.   FROM SYSTEM     IMPORT ADR, ADDRESS, ASSEMBLE, TAG;
  23.   FROM ExecD      IMPORT MemReqs, MemReqSet, Node, NodePtr, MinList;
  24.   FROM ExecL      IMPORT AllocMem, FreeMem, RemTail, Insert;
  25.   FROM GadToolsD  IMPORT buttonKind, listviewKind, GtTags, NewGadgetFlagSet,
  26.                          NewGadgetFlags, stringKind;
  27.   FROM IntuitionD IMPORT WindowPtr, WindowFlagSet, WindowFlags, IDCMPFlagSet,
  28.                          IDCMPFlags, WaTags;
  29. IMPORT D:GUIEnvD,
  30.        L:GUIEnvL;
  31.  
  32.   FROM GUIEnvSupport IMPORT GADDESC, GADOBJS, TopazAttr;
  33.  
  34. CONST version = ADR("$VER: ResizingExample 37.4 (31.10.94)\n");
  35.  
  36. TYPE ListViewArr = ARRAY[0..9] OF ADDRESS;
  37.  
  38. CONST listviewALabs = ListViewArr{ADR("Amiga 500"), ADR("Amiga 500+"),
  39.                        ADR("Amiga 600"), ADR("Amiga 1000"),
  40.                        ADR("Amiga 1200"), ADR("Amiga 2000"),
  41.                        ADR("Amiga 3000"), ADR("Amiga 4000/030"),
  42.                        ADR("Amiga 4000/040"), ADR("Amiga XXXX/yyy")};
  43.       listviewCLabs = ListViewArr{ADR("2086"), ADR("80286"),
  44.                        ADR("80386"), ADR("80486"),
  45.                        ADR("Pentium"), ADR("MC 68000"),
  46.                        ADR("MC 68020"), ADR("MC 68030"),
  47.                        ADR("MC 68040"), ADR("MC 68060")};
  48.  
  49. VAR win : WindowPtr;
  50.     gui : D.GUIInfoPtr;
  51.     tagbuf : ARRAY[0..19] OF LONGCARD;
  52.  
  53.     prg : INTEGER;           (* for the progressIndicatorKind *)
  54.     alist,
  55.     clist  : MinList;        (* Lists for ListviewKind gadget *)
  56.  
  57.   (* Creates two exec.lists. One contains some amiga-models and the other
  58.      some cpu-kinds ! *)
  59.   PROCEDURE CreateLists;
  60.   VAR entry  : NodePtr;
  61.       i      : CARDINAL;
  62.   BEGIN
  63.     (* Init amiga-list & cpu-list/ same as NewList(ADR(...)) *)
  64.     ASSEMBLE(LEA     alist(A4), A0
  65.              MOVE.L  A0,(A0)
  66.              ADDQ.L  #4,(A0)
  67.              CLR.L   4(A0)
  68.              MOVE.L  A0,8(A0)
  69.              LEA     clist(A4), A0
  70.              MOVE.L  A0,(A0)
  71.              ADDQ.L  #4,(A0)
  72.              CLR.L   4(A0)
  73.              MOVE.L  A0,8(A0)
  74.     END);
  75.     FOR i := 0 TO 9 DO     (* make the list-entries *)
  76.       entry := AllocMem(SIZE(Node), MemReqSet{memClear});
  77.       IF entry # NIL THEN
  78.         entry^.name := listviewALabs[i];
  79.         Insert(ADR(alist), entry, NIL);
  80.       END;
  81.       entry := AllocMem(SIZE(Node), MemReqSet{memClear});
  82.       IF entry # NIL THEN
  83.         entry^.name := listviewCLabs[i];
  84.         Insert(ADR(clist), entry, NIL);
  85.       END;
  86.     END;
  87.   END CreateLists;
  88.  
  89. BEGIN
  90.   CreateLists;
  91.  
  92.   win := L.OpenGUIWindowA( 50, 50, 300, 150, ADR("GUIEnvironment - ResizingExample"),
  93.                           IDCMPFlagSet{gadgetUp, closeWindow, newSize,
  94.                                        refreshWindow, vanillaKey, gadgetDown},
  95.                            WindowFlagSet{activate, windowSizing,
  96.                                          windowDepth, windowClose,
  97.                                          windowDrag}, NIL,
  98.                            TAG(tagbuf, waMinWidth, 250,
  99.                                        waMinHeight,120,
  100.                                        waMaxWidth, 500,
  101.                                        waMaxHeight,200, NIL));
  102.   IF win # NIL THEN
  103.  
  104.     gui := L.CreateGUIInfoA(win, TAG(tagbuf, D.guiCreationFont, TopazAttr(), NIL));
  105.     IF gui # NIL THEN
  106.  
  107.       (* This gadget is always 10 points away from the left, the top and
  108.          the also the right window border. And it is also always 35 points
  109.          away from the bottom window border *)
  110.  
  111.       L.CreateGUIGadgetA(gui, 10, 20, -10, -35, D.gegProgressIndicatorKind,
  112.                          TAG(tagbuf, D.gegText, ADR("Progress"),
  113.                                      D.gegFlags, NewGadgetFlagSet{placetextAbove},
  114.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  115.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjTop,
  116.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  117.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjBottom),
  118.                              NIL));
  119.  
  120.       (* This gadget is always 10 points below the progessIndicatorKind
  121.          gadget and always 10 points right of the window border.
  122.          Its size is constant. *)
  123.       L.CreateGUIGadgetA(gui, 10, 10, 70, 18, buttonKind,
  124.                          TAG(tagbuf, D.gegText, ADR("_Plus"),
  125.                                      D.gegFlags, NewGadgetFlagSet{placetextIn},
  126.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  127.                                                            D.gegDistAbs+D.gegObjGadget+D.gegObjBottom,
  128.                                                            D.gegDistNorm,
  129.                                                            D.gegDistNorm),
  130.                              NIL));
  131.  
  132.       (* This gadget is always 10 points below the progessIndicatorKind
  133.          gadget and always 10 points left of the window border.
  134.          Its size is constant. Now we need the gegObjects tag,
  135.          because we don't refer to the previous gadget !
  136.          To say, this gadget is 10 points left of the right window border,
  137.          we must say it is 10+width away from the border !*)
  138.       L.CreateGUIGadgetA(gui, -80, 10, 70, 18, buttonKind,
  139.                          TAG(tagbuf, D.gegText, ADR("_Minus"),
  140.                                      D.gegFlags, NewGadgetFlagSet{placetextIn},
  141.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  142.                                                                D.gegDistAbs+D.gegObjGadget+D.gegObjBottom,
  143.                                                                D.gegDistNorm,
  144.                                                                D.gegDistNorm),
  145.                                      D.gegObjects, GADOBJS(0, 0, 0, 0),
  146.                          NIL));
  147.  
  148.       IF L.DrawGUIA(gui, NIL) = D.geDone THEN
  149.         prg := 0;
  150.         LOOP
  151.           L.WaitGUIMsg(gui);
  152.  
  153.           IF    closeWindow IN gui^.msgClass THEN
  154.             EXIT;
  155.           ELSIF gadgetUp    IN gui^.msgClass THEN
  156.             IF    gui^.msgGadNbr = 1 THEN
  157.               IF prg < 10 THEN INC(prg) END;
  158.               L.SetGUIGadgetA(gui, 0, TAG(tagbuf, D.gegPICurrentValue, prg * 10, NIL));
  159.             ELSIF gui^.msgGadNbr = 2 THEN
  160.               IF prg >  0 THEN DEC(prg) END;
  161.               L.SetGUIGadgetA(gui, 0, TAG(tagbuf, D.gegPICurrentValue, prg * 10, NIL));
  162.             END;
  163.           ELSIF newSize     IN gui^.msgClass THEN
  164.             (* We only get this message if GUIEnvironment can't resize ! *)
  165.             EXIT;
  166.           END;
  167.         END;
  168.       END;
  169.  
  170.       (* And now a total new GUI: *)
  171.       IGNORE L.ChangeGUIA(gui, TAG(tagbuf, D.guiRemoveGadgets, TRUE, NIL));
  172.  
  173.       (* We don't know the actual size of the window now, but our GUI was
  174.         designed for the size 300/150, so we have to say this to GUIEnv.
  175.         We don't want to resize the window, so using the preserve window
  176.         tag tells GUIEnvironment to do so *)
  177.       IGNORE L.ChangeGUIA(gui, TAG(tagbuf, D.guiCreationWidth, 300,
  178.                                            D.guiCreationHeight, 150,
  179.                                            D.guiPreserveWindow, D.guiPWFull, NIL));
  180.  
  181.       (* This string gadget is for the listview gadget to display the
  182.          selected entry ! To the left and to the right it is 20 points
  183.          away from the window border. *)
  184.       L.CreateGUIGadgetA(gui, 20, -45, -20, 13, stringKind,
  185.                          TAG(tagbuf, D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  186.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjBottom,
  187.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  188.                                                                D.gegDistNorm),
  189.                          NIL));
  190.  
  191.       (* This gadget is always 20 points away from the left and the right
  192.          window border. And it is also always 45 points away from the
  193.          bottom window border and 30 from the top window border. *)
  194.  
  195.       L.CreateGUIGadgetA(gui, 20, 30, -20, -45, listviewKind,
  196.                          TAG(tagbuf, D.gegText, ADR("_List"),
  197.                                      D.gegFlags, NewGadgetFlagSet{placetextAbove},
  198.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  199.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjTop,
  200.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  201.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjBottom),
  202.                                      gtlvLabels, ADR(alist),
  203.                                      gtlvShowSelected, L.GetGUIGadget(gui, 0, D.gegAddress), (* the prev. gadget*)
  204.                          NIL));
  205.  
  206.       (* This gadget is always 10 points below the listviewKind
  207.          gadget and always 20 points right of the window border.
  208.          Its size is constant. *)
  209.       L.CreateGUIGadgetA(gui, 20, 10, 70, 18, buttonKind,
  210.                          TAG(tagbuf, D.gegText, ADR("_Amigas"),
  211.                                      D.gegFlags, NewGadgetFlagSet{placetextIn},
  212.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  213.                                                                D.gegDistAbs+D.gegObjGadget+D.gegObjBottom,
  214.                                                                D.gegDistNorm,
  215.                                                                D.gegDistNorm),
  216.                          NIL));
  217.  
  218.       (* This gadget is always 10 points below the listviewKind gadget
  219.          as the previous gadget is also and always 20 points left of the
  220.          window border. Its size is constant.
  221.          To say this gadget is 20 points left of the right window border,
  222.          we must say it is 20+width away from the border !*)
  223.       L.CreateGUIGadgetA(gui, -90, 0, 70, 18, buttonKind,
  224.                          TAG(tagbuf, D.gegText, ADR("_CPUs"),
  225.                                      D.gegFlags, NewGadgetFlagSet{placetextIn},
  226.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  227.                                                                D.gegDistAbs+D.gegObjGadget+D.gegObjTop,
  228.                                                                D.gegDistNorm,
  229.                                                                D.gegDistNorm),
  230.                          NIL));
  231.  
  232.       (* This gadget draws a border around all gadgets which is always
  233.          10 points away from every border *)
  234.       L.CreateGUIGadgetA(gui, 10, 10, -10, -10, D.gegBorderKind,
  235.                          TAG(tagbuf,  D.gegText, ADR("Choose something"),
  236.                                       D.gegFlags, NewGadgetFlagSet{placetextAbove, ngHighlabel},
  237.                                       D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  238.                                                                 D.gegDistAbs+D.gegObjBorder+D.gegObjTop,
  239.                                                                 D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  240.                                                                 D.gegDistAbs+D.gegObjBorder+D.gegObjBottom),
  241.                          NIL));
  242.  
  243.       IF L.DrawGUIA(gui, NIL) = D.geDone THEN
  244.         LOOP
  245.           L.WaitGUIMsg(gui);
  246.  
  247.           IF    closeWindow IN gui^.msgClass THEN
  248.             EXIT;
  249.           ELSIF gadgetUp    IN gui^.msgClass THEN
  250.             IF    gui^.msgGadNbr = 2 THEN  (* Amiga-list *)
  251.               L.SetGUIGadgetA(gui, 1, TAG(tagbuf, gtlvLabels, ADR(alist), NIL));
  252.             ELSIF gui^.msgGadNbr = 3 THEN  (* CPU-list *)
  253.               L.SetGUIGadgetA(gui, 1, TAG(tagbuf, gtlvLabels, ADR(clist), NIL));
  254.             END;
  255.           ELSIF newSize     IN gui^.msgClass THEN
  256.             EXIT;
  257.           END;
  258.         END;
  259.       END;
  260.     END;
  261.   END;
  262.  
  263. CLOSE
  264.   IF win # NIL THEN
  265.     L.CloseGUIWindow(win);
  266.     win := NIL;
  267.   END;
  268.   IF alist.tailPred # NIL THEN  (* Did we reach the InitList ? *)
  269.     WHILE alist.tailPred # ADR(alist) DO    (* free lists *)
  270.       FreeMem(RemTail(ADR(alist)), SIZE(Node));
  271.     END;
  272.     WHILE clist.tailPred # ADR(clist) DO    (* free lists *)
  273.       FreeMem(RemTail(ADR(clist)), SIZE(Node));
  274.     END;
  275.   END;
  276. END ResizingExample.
  277.